#! /usr/bin/env perl

#nebulae.pl
#The MIT License

#Copyright (c) 2008 Andrey A Popov <Popov.Andrey.Anat@gmail.com>

#Permission is hereby granted, free of charge, to any person obtaining a copy
#of this software and associated documentation files (the "Software"), to deal
#in the Software without restriction, including without limitation the rights
#to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
#copies of the Software, and to permit persons to whom the Software is
#furnished to do so, subject to the following conditions:

#The above copyright notice and this permission notice shall be included in
#all copies or substantial portions of the Software.

#THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
#IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
#FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
#AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
#LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
#OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
#THE SOFTWARE.

use strict;
use warnings;
#use Data::Dumper;

my $s       =   qr/[\ \t]*/;
my $r_int   =   qr/[0-9]+/;
my $r_func  =   qr/(?:[A-Z][a-zA-Z0-9\_]*)|(?:[\+\-\*\/\?\!\|\&\%\<\>\:\=\#]+)/;
my $r_var   =   qr/[a-z][a-zA-Z0-9\_]*$s(?:\[(?:[^\]]+)?\])?/;
my $r_type  =   qr/\_[a-zA-Z0-9\_]*(?:\[(?:[^\]]+)?\])?/;
my $r_str   =   qr/"(?:\\.|[^"])*"/;
my $r_char  =   qr/\'.{1,2}\'/;
my $r_eol   =   qr/[\;\n]/;
my $r_qop   =   qr/\(/;
my $r_qed   =   qr/\)/;
my $r_kword =   qr/c_lib|def|end|while|foreach|return|if|else|times|\<\#|\<\:[=]?/;

my $r_expr  =   
qr/$r_kword|$r_func|$r_str|$r_char|$r_var|$r_type|$r_int|$r_qop|$r_qed|$r_eol|$s|\n/;

my %functions = (
    '+'     =>  'add', #ADD int and floating and double and long versions
    '-'     =>  'subt', #same as above
    '*'     =>  'mult',
    '/'     =>  'divi',
    '%'     =>  'modu',
    '++'    =>  'plus_one',
    '--'    =>  'minus_one',
    '<:'    =>  'def_var',
    '!!'    =>  'of_array',
    '='     =>  'equate',
    '=='    =>  'equal_to',
    '<'     =>  'lsthan',
    '>'     =>  'grthan',
    '<='    =>  'lsthaneq',
    '>='    =>  'grthaneq',
    '||'    =>  'or',
    '&&'    =>  'and',
    '<#'    =>  'defun'
    );
my %defuns = ();
my %types = (
    'int'       => 'int',
    'string[]'  => 'char *[]',
    'string'    => 'char []'
    );
my %options = (
    'debug' => 0,
    'c'     => 'nebout.c'
    );
my $tmp_counter_num = 0;
#SECTION#
#MISC#
sub error {
    print STDERR (shift) . "\n";
    exit;
}
sub debug {
    if ($options{'debug'}) {
        print STDOUT (shift) . "\n";
    }
}
#SECTION#
#TREE#
sub source_to_tree {
    our $source = shift;
    my $tree = [];
    while($source =~ m/^$r_expr/) {
        my $match = $&;
        $source = $';
        debug("Match—‘$match’");
        if ($match =~ m/^$r_eol$/) {
            if (not $match eq "\n") {
                $source =~ s/^.*\n//;
            }
            push @$tree, ['eol'];
            #return $tree;
        } elsif ($match =~ m/^$r_kword$/) {
            push @$tree, ['kword', $match];
        } elsif ($match =~ m/^$r_func$/) {
            #push @$tree, ['function', $match, source_to_tree($source)];
            my $func_name = $match;
            if ($func_name =~ m/^[A-Z]/) {
                $func_name = lcfirst $func_name;
            }
            push @$tree, ['function', $func_name];
        } elsif ($match =~ m/^$r_var$/) {
            push @$tree, ['variable', $match];
        } elsif ($match =~ m/^$r_type$/) {
            push @$tree, ['type', $match];
        } elsif ($match =~ m/^$r_int$/) {
            push @$tree, ['integer', $match];
        } elsif ($match =~ m/^$r_char$/) {
            my $char = $match;
            $char =~ s/^\'//;
            $char =~ s/\'$//;
            push @$tree, ['char', $char]
        } elsif ($match =~ m/^$r_str$/) {
            my $str = $match;
            $str =~ s/^\"//;
            $str =~ s/\"$//;
            push @$tree, ['string', $str]
        } elsif ($match =~ m/^$r_qop$/) {
            push @$tree, source_to_tree($source);
        } elsif ($match =~ m/^$r_qed$/) {
            return $tree;
        }
        if ($source =~ m/^$/) { last }
    }
    return $tree;
}
#SECTION#
#C SOURCE#
sub tree_to_source {
    my $tree = shift;
    my $c_code = from_data();
    $c_code .= tree_to_src($tree) . "\n";
    return $c_code;
}
sub tree_to_src {
    my $tree = shift;
    my $c_code = "";
    my $expr;
    my $i;
    for($i = 0; $expr = $tree->[$i]; $i++) {
        while (ref $expr->[0]) { $expr = $expr->[0]; }
        #debug("EXRP" . Dumper($expr));
        #if (ref $expr->[0]) {
        #    $c_code .= tree_to_src([shift @$expr]);
        #} 
        $expr->[0] =~ m/^.*$/;
        my $expr_type = $&;
        if ($expr_type eq 'kword') {
            my $kword = $expr->[1];
            if ($kword eq 'c_lib') {
                my $lib = $tree->[++$i][1];
                $c_code .= "#include <$lib>\n"
            } elsif ($kword eq '<#') {
                my $func_def = [];
                my $func = $tree->[++$i];
                my $func_type = $tree->[++$i];
                my $func_name = $func->[1];
                if (defined $functions{$func_name}) {
                    $func_name = $functions{$func_name};
                }
                $func_name = lcfirst $func_name;
                $func_type = tree_to_src([$func_type]);
                $func_type =~ s/\[\]/\*/;
                
                $c_code .= $func_type . ' ' . $func_name .  '(';
                push @$func_def, $func_type;
                my $arg;
                my $arg_num = 0;
                $i++;
                while(($arg = $tree->[$i]) and (not $arg->[0] eq 'eol')) {
                    if ($arg_num) { $c_code .= ', ' }
                    my $c_arg;
                    if (ref $arg->[0]) {
                        $c_arg = tree_to_src($arg);
                        $c_code .= '(' . $c_arg . ')';
                    } else {
                        $c_arg = tree_to_src([$arg]);
                        my $c_arg_fix = $c_arg;
                        #$c_arg_fix =~ s/&#//;
                        $c_code .= $c_arg_fix;
                    }
                    push @$func_def, $c_arg;
                    $i++;
                    $arg_num++;
                }
                if ($arg->[0] eq 'eol') { $i-- }
                $c_code .= ')';
                $defuns{$func_name} = $func_def;
            } elsif ($kword =~ m/^\<\:/) {
                my $var = $tree->[++$i];
                my $type =  $tree->[++$i];
                if (ref $var->[0]) {
                    $var = tree_to_src($var);
                } else {
                    $var = tree_to_src([$var]);
                }
                if (ref $type->[0]) {
                    $type = tree_to_src($type);
                } else {
                    $type = tree_to_src([$type]);
                }
                if ($type =~ m/\[(?:[^\]]+)?\]/) {
                    my $c_arg = $type;
                    $c_arg =~ s/(\[(?:[^\]]+)?\])/ $var$1/;
                    $c_code .= $c_arg;
                } else {
                    $c_code .= $type . ' ' . $var;
                }
                if ($kword eq '<:=') {
                    my $equals = $tree->[++$i];
                    $c_code .= ' = ';
                    if (ref $equals->[0]) {
                        $equals = tree_to_src($equals);
                    } else {
                        $equals = tree_to_src([$equals]);
                    }
                    $c_code .= $equals;
                }
            } elsif ($kword eq 'times') {
                my $tmp_counter = "tmp_counter" . $tmp_counter_num++;
                $c_code .= "def_var($tmp_counter, int);\n";
                my $loop_until = $tree->[++$i];
                if (ref $loop_until->[0]) {
                    $loop_until = tree_to_src($loop_until);
                } else {
                    $loop_until = tree_to_src([$loop_until]);
                }
                $c_code .= 
                "for($tmp_counter = 0;
                $tmp_counter < " . $loop_until . ";
                $tmp_counter\+\+) {";
            } elsif ($kword eq 'def') {
                my $func_name = $tree->[++$i];
                $func_name = $func_name->[1];
                if (defined $functions{$func_name}) {
                    $func_name = $functions{$func_name};
                }
                $func_name = lcfirst $func_name;
                my $func_def;
                if ($func_def = $defuns{$func_name}) {
                    #$c_code .= 
                } else { error("The function ‘$func_name’ is not defined.") }
                my $func_type = $func_def->[0];
                $func_type =~ s/\[\]/\*/;
                $c_code .= $func_type . ' ' . $func_name . '(';
                my $j;
                my $arg_num = 0;
                for ($j = 1; $func_def->[$j]; $j++) {
                    if($arg_num) { $c_code .= ', ' }
                    my $var = tree_to_src([$tree->[++$i]]);
                    my $type = $func_def->[$j];
                    if ($type =~ m/\[(?:$r_int)?\]/) {
                        my $c_arg = $type;
                        $c_arg =~ s/(\[(?:$r_int)?\])/$var$1/;
                        $c_code .= $c_arg;
                    } else {
                        $c_code .= $type . ' ' . $var;
                    }
                    $arg_num++;
                }
                $c_code .= ') {';
            } elsif ($kword eq 'if' or $kword eq 'else') {
                my $just_else = 1;
                if ($kword eq 'else') { $c_code .= "} else "; }
                my $next_term = $tree->[$i+1];
                $next_term = $next_term->[1];
                if ($kword eq 'if' or 
                    (defined $next_term and $next_term eq 'if')) {
                    $just_else = 0;
                    if($next_term eq 'if') { $i++; }
                    $c_code .= 'if (';
                    my $arg;
                    $i++;
                    while(($arg = $tree->[$i]) and (not $arg->[0] eq 'eol')) {
                        $c_code .= tree_to_src($arg);
                        $i++;
                    }
                    if ((defined $arg->[0]) and ($arg->[0] eq 'eol')) { $i-- }
                    $c_code .= ") {";
                }
                if ($just_else) { $c_code .= "{"; }
            } elsif ($kword eq 'while') {
                my $condition = $tree->[++$i];
                $c_code .= 'while (';
                if (ref $condition->[0]) {
                    $c_code .= tree_to_src($condition);
                } else {
                    $c_code .= tree_to_src([$condition]);
                }
                $c_code .= ') {';
            } elsif ($kword eq 'foreach') {
                my $tmp_counter = "tmp_counter" . $tmp_counter_num++;
                $c_code .= "def_var($tmp_counter, int);\n";
                my $array = $tree->[++$i];
                if (ref $array->[0]) {
                    $array = tree_to_src($array);
                } else {
                    $array = tree_to_src([$array]);
                }
                my $as_var = $tree->[++$i];
                if (ref $as_var->[0]) {
                    $as_var = tree_to_src($as_var);
                } else {
                    $as_var = tree_to_src([$as_var]);
                }
                $c_code .= 
                "for($tmp_counter = 0; 
                $as_var = ${array}[${tmp_counter}];
                $tmp_counter\+\+) {";
            } elsif ($kword eq 'end') {
                $c_code .= "}";
            } elsif ($kword eq 'return') {
                my $to_return = $tree->[++$i];
                if (ref $to_return->[0]) {
                    $c_code .= 'return ' . tree_to_src($to_return);
                } else {
                    $c_code .= 'return ' . tree_to_src([$to_return]);
                }
            }
        } elsif ($expr_type eq 'function') {
            my $eol = 0;
            $expr->[1] =~ m/^$r_var|$r_func$/;
            my $func_name = $&;
            if (defined $functions{$func_name}) {
                $func_name = $functions{$func_name};
            }
            $func_name = lcfirst $func_name;
            debug("Function Found—‘$func_name’");
            $c_code .= $func_name . '(';
            my $arg;
            my $arg_num = 0;
            $i++;
            while(($arg = $tree->[$i]) and (not $arg->[0] eq 'eol')) {
                if ($arg_num) { $c_code .= ', ' }
                if (ref $arg->[0]) {
                    $c_code .= '(' . tree_to_src($arg) . ')';
                } else {
                    $c_code .= tree_to_src([$arg]);
                }
                $i++;
                $arg_num++;
            }
            if ((defined $arg->[0]) and ($arg->[0] eq 'eol')) { $i-- }
            $c_code .= ')';
            if ($eol) { $c_code .= ";\n" }
        } elsif ($expr_type eq 'integer') {
            $c_code .= $expr->[1];
        } elsif ($expr_type eq 'variable') {
            $c_code .= $expr->[1];
        } elsif ($expr_type eq 'type') {
            $expr->[1] =~ m/^\_/;
            my $type = $';
            if (defined $types{$type}) { $type = $types{$type} } 
            $c_code .= $type;
        } elsif ($expr_type eq 'char') {
            $c_code .= '\'' . $expr->[1] . '\'';
        } elsif ($expr_type eq 'string') {
            $c_code .= '"' . $expr->[1] . '"';
        } elsif ($expr_type eq 'eol') { 
            $c_code .= ";\n"
        }
    }
    return $c_code;
}

#SECTION#
#FIRST#
sub from_data {
    my $data = "";
    while (<DATA>) {
        $data .= $_;
    }
    return $data;
}
sub from_file {
    my $file = shift;
    my $data = "";
    if (-e $file) {
        open(SOURCEFILE, "<" . $file);
        while (<SOURCEFILE>) {
            $data .= $_;
        }
        close(SOURCEFILE);
    } else {
        error("The file “$file” was not found.");
    }
    return $data;
}
sub main {
    my $args = shift;
    my $argc = $args->[0];
    my @argv = $args->[1];
    my $source = ";";
    if ($argc) {
        my $arg;
        foreach $arg (@ARGV) {
            if ($arg =~ m/^[\-]{1,2}([^=]+)\=([^=]+)$/) {
                my $arg_name = $1;
                my $arg_value = $2;
                if (defined $options{$arg_name}) {
                    $options{$arg_name} = $arg_value;
                }
            } elsif ($arg =~ m/^[\-]{1,2}.*$/) {
                $arg =~ s/^[\-]{1,2}//;
                #print $arg;
                if (defined $options{$arg}) {
                    $options{$arg} = not $options{$arg};
                }
            } elsif ($arg =~ m/^.*$/) {
                $source = from_file($arg);
            }
        }
    }
    my $source_tree = source_to_tree($source);
    #debug(Dumper($source_tree));
    open(OUTFILE, ">" . $options{'c'});
    print OUTFILE tree_to_source($source_tree);
    close(OUTFILE);
}

main([$#ARGV+1, @ARGV]);
__DATA__
#define add(a,b) (a+b)
#define subt(a,b) (a-b)
#define mult(a,b) (a*b)
#define divi(a,b) (a/b)
#define modu(a,b) (a%b)
#define plus_one(a) (a++)
#define minus_one(a) (a--)
#define equal_to(a,b) (a==b)
#define lsthan(a,b) (a<b)
#define grthan(a,b) (a>b)
#define lsthaneq(a,b) (a<=b)
#define grthaneq(a,b) (a>=b)
#define or(a,b) (a || b)
#define and(a,b) (a && b)
#define def_var(var,type) type var
#define of_array(array,i) array[i]
#define equate(var, b) var = b
#define putStr(str) printf(str)
#define from_ptr(a) &a
#define ptr(a) *a
#define not(a) (!a)
